unit DomainRest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, FMTBcd, SqlExpr, DB;

type
  TDmn = class(TDataModule)
    OldDmn: TSQLDataSet;
    NewDmn: TSQLDataSet;
  private
    { Private declarations }
    function Tbl(DBType: Byte): TDataSet;
    function DomainName(DBType : Byte) : String;
    function FieldSize(DBType: Byte): String;
    function FieldPrecision(DBType: Byte): String;
    function FieldScale(DBType: Byte): String;
    function FieldType(DBType: Byte): String;
    function FieldNullProp(DBType: Byte): String;
    function IsFieldNull(DBType: Byte): Boolean;
    function ValueEqual(FName : String) : Boolean;
    function GetValue(FName : String; IsChar : Boolean) : String;

    procedure CreateDomain;
    procedure AlterDomainType;
    procedure AlterDomainDefault;
    procedure AlterDomainValidation;
  public
    { Public declarations }
    procedure CheckDomain;
  end;

var
  Dmn: TDmn;

procedure CheckDomains(ProgBar : TProgressBar);

implementation

uses Data, ReportForm;

{$R *.DFM}

{ TDmn }
procedure CheckDomains;
begin
  ProgBar.Position:=0;
  // how many domains are there ?
  Dmn.NewDmn.CommandText:=
    'select count(*) as ccc from RDB$FIELDS '+
    'where RDB$SYSTEM_FLAG<>1 and '+
    'rdb$field_name not like '#39'RDB$%'#39;
  Dmn.NewDmn.Open;
  ProgBar.Max:=Dmn.NewDmn.fieldByName('ccc').AsInteger;
  Dmn.NewDmn.Close;

  Dmn.NewDmn.CommandText:=
    'select * from RDB$FIELDS '+
    'where RDB$SYSTEM_FLAG<>1 and '+
    'rdb$field_name not like '#39'RDB$%'#39;

  Dmn.NewDmn.Open;
  Dmn.OldDmn.Open;
  Dmn.NewDmn.First;
  While not Dmn.NewDmn.Eof do
  begin
    Application.ProcessMessages;
    ProgBar.Position:=ProgBar.Position+1;
    Dmn.CheckDomain;
    Dmn.NewDmn.Next;
  end;
  Dmn.OldDmn.Close;
  Dmn.NewDmn.Close;
end;

{ TDmn }

function TDmn.Tbl(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewDmn;
    fcOld : Result:=OldDmn;
  end;
end;

function TDmn.DomainName(DBType: Byte): String;
begin
  Result:=Trim(Tbl(DBType).FieldByName('RDB$FIELD_NAME').AsString);
end;

function TDmn.FieldSize(DBType : Byte) : String;
begin
  Result:=Tbl(DBType).FieldByName('RDB$FIELD_LENGTH').AsString;
end;

function TDmn.FieldPrecision(DBType : Byte) : String;
begin
  Result:=Tbl(DBType).FieldByName('RDB$FIELD_PRECISION').AsString;
end;

function TDmn.FieldScale(DBType : Byte) : String;
begin
  Result:=IntToStr(-Tbl(DBType).FieldByName('RDB$FIELD_SCALE').AsInteger);
end;

function TDmn.FieldType(DBType : Byte): String;
begin
  case Tbl(DBType).FieldByName('RDB$FIELD_TYPE').AsInteger of
    7  : Result:='SMALLINT';
    8  : Result:='INTEGER';
    10 : Result:='FLOAT';
    12 : Result:='DATE'; // in dialect 3
    13 : Result:='TIME'; // in dialect 3
    16 : Result:='NUMERIC('+FieldPrecision(DBType)+','+FieldScale(DBType)+')';
    14 : Result:='CHAR('+FieldSize(DBType)+')';
    27 : Result:='DOUBLE PRECISION';
    35 : if DM.Dialect=1 then
           Result:='DATE' // in dialect 1
         else
           Result:='TIMESTAMP'; // in dialect 3
    37 : Result:='VARCHAR('+FieldSize(DBType)+')';
    261: Result:='BLOB SUB_TYPE '+Tbl(DBType).FieldByName('RDB$FIELD_SUB_TYPE').AsString+
           ' SEGMENT SIZE '+Tbl(DBType).FieldByName('RDB$SEGMENT_LENGTH').AsString;
  end;
end;

function TDmn.FieldNullProp(DBType : Byte) : String;
begin
  Result:=Tbl(DBType).FieldByName('RDB$NULL_FLAG').AsString;
end;

function TDmn.IsFieldNull(DBType : Byte) : Boolean;
begin
  Result:=FieldNullProp(DBType)<>'1';
end;

function TDmn.GetValue(FName : String; IsChar: Boolean): String;
begin
  Result:=NewDmn.FieldByName(FName).AsString;
  if Result='' then
    Result:='NULL'
  else
    if IsChar then Result:=#39+Result+#39;
end;

function TDmn.ValueEqual(FName: String): Boolean;
begin
  Result:=Tbl(fcNew).FieldByName(FName).AsString=Tbl(fcOld).FieldByName(FName).AsString;
end;

procedure TDmn.CreateDomain;
begin
  DM.SQL.Clear;
  if DM.Dialect=1 then
    DM.SQL.Add('CREATE DOMAIN '+DomainName(fcNew)+' AS')
  else
    DM.SQL.Add('CREATE DOMAIN "'+DomainName(fcNew)+'" AS');
  DM.SQL.Add(FieldType(fcNew));
  if not IsFieldNull(fcNew) then
    DM.SQL.Add('NOT NULL');

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('DOMAIN',Trim(DomainName(fcNew)),'not exist');
    except
      on E:Exception do
      begin
        ShowMessage(E.Message);
        if DM.ShowReport then Rep.AddToReport('DOMAIN',Trim(DomainName(fcNew)),'error');
      end;
    end;
  end else
  begin
    DM.AddToStrings('Domain '+Trim(DomainName(fcNew)),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('DOMAIN',Trim(DomainName(fcNew)),'not exist');
  end;
end;

procedure TDmn.AlterDomainType;
begin
  DM.SQL.Clear;
  DM.SQL.Add('UPDATE RDB$FIELDS set');
  DM.SQL.Add('RDB$FIELD_TYPE = '+GetValue('RDB$FIELD_TYPE',False)+',');
  DM.SQL.Add('RDB$FIELD_SUB_TYPE = '+GetValue('RDB$FIELD_SUB_TYPE',False)+',');
  DM.SQL.Add('RDB$FIELD_LENGTH = '+GetValue('RDB$FIELD_LENGTH',False)+',');
  DM.SQL.Add('RDB$CHARACTER_LENGTH = '+GetValue('RDB$CHARACTER_LENGTH',False)+',');
  //DM.SQL.Add('RDB$DEFAULT_VALUE = '+GetValue('RDB$DEFAULT_VALUE',False)+',');
  DM.SQL.Add('RDB$DESCRIPTION = '+GetValue('RDB$DESCRIPTION',True)+',');
  DM.SQL.Add('RDB$NULL_FLAG = '+GetValue('RDB$NULL_FLAG',False));
  DM.SQL.Add('WHERE RDB$FIELD_NAME = '#39+DomainName(fcNew)+#39);

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('DOMAIN',Trim(DomainName(fcNew)),'different type');
    except
      if DM.ShowReport then Rep.AddToReport('DOMAIN',Trim(DomainName(fcNew)),'error');
    end
  end else
  begin
    DM.AddToStrings('Domain '+Trim(DomainName(fcNew)),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('DOMAIN',Trim(DomainName(fcNew)),'different type');
  end;
end;

procedure TDmn.AlterDomainDefault;
begin
  DM.SQL.Clear;
  if DM.Dialect=1 then
    DM.SQL.Add('ALTER DOMAIN '+DomainName(fcNew)+' AS')
  else
    DM.SQL.Add('ALTER DOMAIN "'+DomainName(fcNew)+'" AS');
  DM.SQL.Add('DROP DEFAULT');

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
    except
      if DM.ShowReport then Rep.AddToReport('Domain',Trim(DomainName(fcNew)),'drop default error');
    end;
  end else
    DM.AddToStrings('DOMAIN '+DomainName(fcNew),DM.SQL);

  DM.SQL.Clear;
  if DM.Dialect=1 then
    DM.SQL.Add('ALTER DOMAIN '+DomainName(fcNew)+' AS')
  else
    DM.SQL.Add('ALTER DOMAIN "'+DomainName(fcNew)+'" AS');
  DM.SQL.Add('SET '+Tbl(fcNew).FieldByName('RDB$DEFAULT_SOURCE').AsString);

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('DOMAIN ',Trim(DomainName(fcNew)),' default different');
    except
      if DM.ShowReport then Rep.AddToReport('DOMAIN ',Trim(DomainName(fcNew)),'add default error');
    end;
  end else
  begin
    DM.AddToStrings('DOMAIN '+DomainName(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('DOMAIN ',Trim(DomainName(fcNew)),'different');
  end;
end;

procedure TDmn.AlterDomainValidation;
begin
  DM.SQL.Clear;
  if DM.Dialect=1 then
    DM.SQL.Add('ALTER DOMAIN '+DomainName(fcNew)+' AS')
  else
    DM.SQL.Add('ALTER DOMAIN "'+DomainName(fcNew)+'" AS');
  DM.SQL.Add('DROP CONSTRAINT');

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
    except
      if DM.ShowReport then Rep.AddToReport('Domain',Trim(DomainName(fcNew)),'drop validation error');
    end;
  end else
    DM.AddToStrings('DOMAIN '+DomainName(fcNew),DM.SQL);

  DM.SQL.Clear;
  if DM.Dialect=1 then
    DM.SQL.Add('ALTER DOMAIN '+DomainName(fcNew)+' AS')
  else
    DM.SQL.Add('ALTER DOMAIN "'+DomainName(fcNew)+'" AS');
  DM.SQL.Add('ADD '+Tbl(fcNew).FieldByName('RDB$VALIDATION_SOURCE').AsString);

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('DOMAIN ',Trim(DomainName(fcNew)),' validation different');
    except
      if DM.ShowReport then Rep.AddToReport('DOMAIN ',Trim(DomainName(fcNew)),'add validation error');
    end;
  end else
  begin
    DM.AddToStrings('DOMAIN '+DomainName(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('DOMAIN ',Trim(DomainName(fcNew)),'validation different');
  end;
end;

procedure TDmn.CheckDomain;
begin
  OldDmn.Close;
  OldDmn.ParamByName('DName').AsString:=DomainName(fcNew);
  OldDmn.Open;
  if DomainName(fcOld)=DomainName(fcNew) then
  begin
    // checking donain type
    if ValueEqual('RDB$FIELD_TYPE') and ValueEqual('RDB$FIELD_SUB_TYPE') and
      ValueEqual('RDB$FIELD_LENGTH') and ValueEqual('RDB$CHARACTER_LENGTH') and
      ValueEqual('RDB$NULL_FLAG') then
    begin
    end else AlterDomainType;

    // checking default value
    if not ValueEqual('RDB$DEFAULT_SOURCE') then AlterDomainDefault;

    // checking validation
    if not ValueEqual('RDB$VALIDATION_SOURCE') then AlterDomainValidation;

  end else CreateDomain;
end;

end.
